perm filename CON4[AM,DBL]2 blob
sn#168619 filedate 1975-07-17 generic text, type T, neo UTF8
(FILECREATED "17-JUL-75 17:09:59" <LENAT>CON4.;15 66170
changes to: INIT-C CONCEPTS OSET-STRUC-DELETE SET-STRUC-DELETE
previous date: "14-JUL-75 16:09:54" <LENAT>CON4.;14)
(LISPXPRINT (QUOTE CON4COMS)
T T)
[RPAQQ CON4COMS
((FNS BAG CLASS FORMAT INIT-C OSET PAIR STRUC VECTOR)
CONCEPTS
(VARS * CONCEPTS)
FACETS
(VARS * FACETS)
(FNS * FACETS)
AUX-FACETS
(VARS * AUX-FACETS)
SUF-PARTS STRATEGY-PARTS XEQ-PARTS XS-PARTS OR-PARTS [COMS * (LIST (CONS (QUOTE IFPROP)
(CONS (QUOTE ALL)
CONCEPTS]
[COMS * (LIST (CONS (QUOTE IFPROP)
(CONS (QUOTE ALL)
FACETS]
[COMS * (LIST (CONS (QUOTE IFPROP)
(CONS (QUOTE ALL)
AUX-FACETS]
(P (INIT-C))
(DECLARE: DONTEVAL@LOAD DOEVAL@COMPILE DONTCOPY COMPILERVARS
(ADDVARS (NLAMA VECTOR STRUC PAIR OSET FORMAT CLASS BAG)
(NLAML WORTH VIEW UP SUGG SPEC RESTRUC RANGE INV INTU INT-NOT INT INIT IN-RAN-OF IN-DOM-OF
GENL FILLIN2 FILLIN1 FILLIN EXS-NOT-BDY EXS-NOT EXS-BDY EXS DOMAIN DEFN-NOT DEFN
D-R CHECK2 CHECK1 CHECK ANAS ALGS]
(DEFINEQ
(BAG
[NLAMBDA X
(CONS (QUOTE BAG)
X])
(CLASS
[NLAMBDA X
(CONS (QUOTE CLASS)
X])
(FORMAT
[NLAMBDA Z
(CONS (QUOTE FORMAT)
Z])
(INIT-C
[LAMBDA (R1)
(MOVD (QUOTE OR)
(QUOTE ANY-OF))
(MOVD (QUOTE GETP)
(QUOTE FGETB))
(MOVD (QUOTE APPLY*)
(QUOTE APPLYB))
(MOVD (QUOTE APPEND)
(QUOTE ALL-OF))
(MOVD (QUOTE CAR)
(QUOTE IPRED))
(MOVD (QUOTE CADR)
(QUOTE IDEF))
(MOVD (QUOTE CAR)
(QUOTE PINT))
(MOVD (QUOTE CADR)
(QUOTE P-OP))
(MOVD (QUOTE CADDR)
(QUOTE P-B))
(MOVD (QUOTE CADDDR)
(QUOTE P-P))
(MOVD (QUOTE CADDR)
(QUOTE IVAL))
(MOVD (QUOTE CDDR)
(QUOTE IFEATURES))
(MOVD (QUOTE CADR)
(QUOTE IFEA))
(MOVD (QUOTE CAAR)
(QUOTE CSINT))
(MOVD (QUOTE CDR)
(QUOTE CSOTHERS))
(MOVD (QUOTE CAR)
(QUOTE CSBEST))
(MOVD (QUOTE CAR)
(QUOTE CINT))
(MOVD (QUOTE RPLACA)
(QUOTE RPLACINT))
(MOVD (QUOTE CADR)
(QUOTE COP))
(MOVD (QUOTE CADDR)
(QUOTE CB))
(MOVD (QUOTE CADDDR)
(QUOTE CP))
(MOVD (QUOTE CDR)
(QUOTE CACT))
(SETQ HCON (HARRAY 503))
(SETQ RANU (QUOTE DOUG))
(SETQ RANC (QUOTE ANYB))
(SETQQ RANF RAND-USER)
(SETQ CIRC (HARRAY 500))
(PUTHASH (QUOTE RAND-OBJ)
(QUOTE RAND-USER)
CIRC)
(PUTHASH (QUOTE RAND-USER)
(QUOTE RAND-CON)
CIRC)
(PUTHASH (QUOTE RAND-CON)
(QUOTE RAND-OBJ)
CIRC)
(SETQ OBJX (EXS OBJECT))
[MAPC CONCEPTS (FUNCTION (LAMBDA (B)
(PUTHASH B 1 HCON)
(PUTD B (COPY TRIVB))
(DEFB B]
[MAP (SETQ R1 (RAND-PERMUTE CONCEPTS))
(FUNCTION (LAMBDA (C)
(PUTHASH (CAR C)
(CADR C)
CIRC]
(PUTHASH (CAR (LAST R1))
(CAR R1)
CIRC)
[MAP (SETQ R1 (RAND-PERMUTE USERNAMES))
(FUNCTION (LAMBDA (C)
(PUTHASH (CAR C)
(CADR C)
CIRC]
(PUTHASH (CAR (LAST R1))
(CAR R1)
CIRC)
(PRIN1 "THE NUMBER OF CONCEPTS IS ")
(PRINT (LENGTH CONCEPTS))
(SETQ SUF1 (HARRAY 60))
(SETQ SUF2 (HARRAY 60))
(SETQ SWSUF (HARRAY 60))
[MAPC SUF-PARTS (FUNCTION (LAMBDA (FACET)
(PUTHASH FACET (PACK (LIST FACET 1))
SUF1)
(PUTHASH FACET (PACK (LIST FACET 2))
SUF2)
(PUTHASH (GETHASH FACET SUF2)
(GETHASH FACET SUF1)
SWSUF)
(PUTHASH (GETHASH FACET SUF1)
(GETHASH FACET SUF2)
SWSUF]
(CPRIN1 0 CRLF "INITIALIZATION COMPLETED. TO START AM, TYPE (START)" CRLF])
(OSET
[NLAMBDA X
(CONS (QUOTE OSET)
X])
(PAIR
[NLAMBDA X
(CONS (QUOTE PAIR)
X])
(STRUC
[NLAMBDA X
(CONS (QUOTE STRUC)
X])
(VECTOR
[NLAMBDA X
(CONS (QUOTE VECTOR)
X])
)
(RPAQQ CONCEPTS
(ACTIVE ACTIVE-D-R ACTIVE-EXS ACTIVE-INST ANYB ANYB-ANAS ANYB-ANYP ANYB-CHECK ANYB-CHECK1 ANYB-CHECK2 ANYB-D-R
ANYB-DEFN ANYB-DEFN-NOT ANYB-DOMAIN ANYB-EXS ANYB-EXS-BDY ANYB-EXS-NOT ANYB-EXS-NOT-BDY ANYB-FILLIN
ANYB-FILLIN1 ANYB-FILLIN2 ANYB-GENL ANYB-IN-DOM-OF ANYB-IN-RAN-OF ANYB-INIT ANYB-INST ANYB-INT
ANYB-INT-NOT ANYB-INTU ANYB-INV ANYB-RANGE ANYB-RESTRUC ANYB-SPEC ANYB-SUGG ANYB-UP ANYB-VIEW
ANYB-WORTH ANYTHING BAG-STRUC BAG-STRUC-DELETE BAG-STRUC-INSERT COMPOSE COMPOSE-D-R COMPOSE-EXS
COMPOSE-EXS-D-R CONSTRUCTIVE FINAL FIRST LIST-STRUC LIST-STRUC-DELETE LIST-STRUC-INSERT MULT-STRUC
NONMULT-STRUC OBJ-EQUAL OBJECT OBJECT-EXS OPERATION ORD-OBJ ORD-OBJ-EXS ORD-PAIR OSET-STRUC
OSET-STRUC-DELETE OSET-STRUC-INSERT PREDICATE REAR RELATION SET-STRUC SET-STRUC-DELETE SET-STRUC-DIFF
SET-STRUC-INSERT SET-STRUC-INTERSECT STRUCTURE STRUCTURE-DELETE STRUCTURE-DIFF STRUCTURE-EQUAL
STRUCTURE-EXS STRUCTURE-EXS-BDY STRUCTURE-INSERT STRUCTURE-INTERSECT STRUCTURE-MEMB TRUTH-VAL
UNORD-OBJ UNORD-OBJ-EXS))
(RPAQQ ACTIVE (FROM-FILE CON4))
(RPAQQ ACTIVE-D-R (FROM-FILE CON4))
(RPAQQ ACTIVE-EXS (FROM-FILE CON4))
(RPAQQ ACTIVE-INST (FROM-FILE CON4))
(RPAQQ ANYB (FROM-FILE CON4))
(RPAQQ ANYB-ANAS (FROM-FILE CON4))
(RPAQQ ANYB-ANYP (FROM-FILE CON4))
(RPAQQ ANYB-CHECK (FROM-FILE CON4))
(RPAQQ ANYB-CHECK1 (FROM-FILE CON4))
(RPAQQ ANYB-CHECK2 (FROM-FILE CON4))
(RPAQQ ANYB-D-R (FROM-FILE CON4))
(RPAQQ ANYB-DEFN (FROM-FILE CON4))
(RPAQQ ANYB-DEFN-NOT (FROM-FILE CON4))
(RPAQQ ANYB-DOMAIN (FROM-FILE CON4))
(RPAQQ ANYB-EXS (FROM-FILE CON4))
(RPAQQ ANYB-EXS-BDY (FROM-FILE CON4))
(RPAQQ ANYB-EXS-NOT (FROM-FILE CON4))
(RPAQQ ANYB-EXS-NOT-BDY (FROM-FILE CON4))
(RPAQQ ANYB-FILLIN (FROM-FILE CON4))
(RPAQQ ANYB-FILLIN1 (FROM-FILE CON4))
(RPAQQ ANYB-FILLIN2 (FROM-FILE CON4))
(RPAQQ ANYB-GENL (FROM-FILE CON4))
(RPAQQ ANYB-IN-DOM-OF (FROM-FILE CON4))
(RPAQQ ANYB-IN-RAN-OF (FROM-FILE CON4))
(RPAQQ ANYB-INIT (FROM-FILE CON4))
(RPAQQ ANYB-INST (FROM-FILE CON4))
(RPAQQ ANYB-INT (FROM-FILE CON4))
(RPAQQ ANYB-INT-NOT (FROM-FILE CON4))
(RPAQQ ANYB-INTU (FROM-FILE CON4))
(RPAQQ ANYB-INV (FOUT CON4))
(RPAQQ ANYB-RANGE (FROM-FILE CON4))
(RPAQQ ANYB-RESTRUC (FROM-FILE CON4))
(RPAQQ ANYB-SPEC (FROM-FILE CON4))
(RPAQQ ANYB-SUGG (FROM-FILE CON4))
(RPAQQ ANYB-UP (FROM-FILE CON4))
(RPAQQ ANYB-VIEW (FROM-FILE CON4))
(RPAQQ ANYB-WORTH (FROM-FILE CON4))
(RPAQQ ANYTHING (FROM-FILE CON4))
(RPAQQ BAG-STRUC (FROM-FILE CON4))
(RPAQQ BAG-STRUC-DELETE (FROM-FILE CON4))
(RPAQQ BAG-STRUC-INSERT (FROM-FILE CON4))
(RPAQQ COMPOSE (FROM-FILE CON4))
(RPAQQ COMPOSE-D-R (FROM-FILE CON4))
(RPAQQ COMPOSE-EXS (FROM-FILE CON4))
(RPAQQ COMPOSE-EXS-D-R (FROM-FILE CON4))
(RPAQQ CONSTRUCTIVE (FROM-FILE CON4))
(RPAQQ FINAL (FROM-FILE CON4))
(RPAQQ FIRST (FROM-FILE CON4))
(RPAQQ LIST-STRUC (FROM-FILE CON4))
(RPAQQ LIST-STRUC-DELETE (FROM-FILE CON4))
(RPAQQ LIST-STRUC-INSERT (FROM-FILE CON4))
(RPAQQ MULT-STRUC (FROM-FILE CON4))
(RPAQQ NONMULT-STRUC (FROM-FILE CON4))
(RPAQQ OBJ-EQUAL (FROM-FILE CON4))
(RPAQQ OBJECT (FROM-FILE CON4))
(RPAQQ OBJECT-EXS (FROM-FILE CON4))
(RPAQQ OPERATION (FROM-FILE CON4))
(RPAQQ ORD-OBJ (FROM-FILE CON4))
(RPAQQ ORD-OBJ-EXS (FROM-FILE CON4))
(RPAQQ ORD-PAIR (FROM-FILE CON4))
(RPAQQ OSET-STRUC (FROM-FILE CON4))
(RPAQQ OSET-STRUC-DELETE (FROM-FILE CON4))
(RPAQQ OSET-STRUC-INSERT (FROM-FILE CON4))
(RPAQQ PREDICATE (FROM-FILE CON4))
(RPAQQ REAR (FROM-FILE CON4))
(RPAQQ RELATION (FROM-FILE CON4))
(RPAQQ SET-STRUC (FROM-FILE CON4))
(RPAQQ SET-STRUC-DELETE (FROM-FILE CON4))
(RPAQQ SET-STRUC-DIFF (FROM-FILE CON4))
(RPAQQ SET-STRUC-INSERT (FROM-FILE CON4))
(RPAQQ SET-STRUC-INTERSECT (FROM-FILE CON4))
(RPAQQ STRUCTURE (FROM-FILE CON4))
(RPAQQ STRUCTURE-DELETE (FROM-FILE CON4))
(RPAQQ STRUCTURE-DIFF (FROM-FILE CON4))
(RPAQQ STRUCTURE-EQUAL (FROM-FILE CON4))
(RPAQQ STRUCTURE-EXS (FROM-FILE CON4))
(RPAQQ STRUCTURE-EXS-BDY (FROM-FILE CON4))
(RPAQQ STRUCTURE-INSERT (FROM-FILE CON4))
(RPAQQ STRUCTURE-INTERSECT (FROM-FILE CON4))
(RPAQQ STRUCTURE-MEMB (FROM-FILE CON4))
(RPAQQ TRUTH-VAL (FROM-FILE CON4))
(RPAQQ UNORD-OBJ (FROM-FILE CON4))
(RPAQQ UNORD-OBJ-EXS (FROM-FILE CON4))
(RPAQQ FACETS
(ALGS ANAS CHECK CHECK1 CHECK2 D-R DEFN DEFN-NOT DOMAIN EXS EXS-BDY EXS-NOT EXS-NOT-BDY FILLIN FILLIN1 FILLIN2
GENL IN-DOM-OF IN-RAN-OF INIT INST INT INT-NOT INTU INV RANGE RESTRUC SPEC SUGG UP VIEW WORTH))
(RPAQQ ALGS NIL)
(RPAQQ ANAS NIL)
(RPAQQ CHECK NIL)
(RPAQQ CHECK1 NIL)
(RPAQQ CHECK2 NIL)
(RPAQQ D-R D-R)
(RPAQQ DEFN NIL)
(RPAQQ DEFN-NOT NIL)
(RPAQQ DOMAIN NOBIND)
(RPAQQ EXS NIL)
(RPAQQ EXS-BDY NIL)
(RPAQQ EXS-NOT NIL)
(RPAQQ EXS-NOT-BDY NIL)
(RPAQQ FILLIN NIL)
(RPAQQ FILLIN1 NIL)
(RPAQQ FILLIN2 NIL)
(RPAQQ GENL NIL)
(RPAQQ IN-DOM-OF NOBIND)
(RPAQQ IN-RAN-OF NOBIND)
(RPAQQ INIT NIL)
(RPAQQ INST NOBIND)
(RPAQQ INT NIL)
(RPAQQ INT-NOT NIL)
(RPAQQ INTU INTU)
(RPAQQ INV NIL)
(RPAQQ RANGE NOBIND)
(RPAQQ RESTRUC NIL)
(RPAQQ SPEC NIL)
(RPAQQ SUGG NIL)
(RPAQQ UP NIL)
(RPAQQ VIEW NIL)
(RPAQQ WORTH NIL)
(DEFINEQ
(ALGS
[NLAMBDA (B BA1 BA2 BA3 BA4)
(POR (QUOTE ALGS)
B BA1 BA2 BA3 BA4])
(ANAS
[NLAMBDA (B BA1 BA2 BA3)
(PXEQ (QUOTE ANAS)
B BA1 BA2 BA3])
(CHECK
[NLAMBDA (B BA1 BA2 BA3 BA4 RS C1 PP P)
(AND (SETQ C1 (GETP (QUOTE CHECK)
(QUOTE CENT)))
(SETQ RS (RIPPLE-SIMULT B C1))
(SETQQ PP CHECK)
(OR (AND BA1 (FMEMB BA1 FACETS)
(SETQ PP BA1)
[SETQ RS (MAPCONC RS (FUNCTION (LAMBDA (R)
(IS-CON-L (GLUE R BA1]
[NCONC RS (MAPCONC RS (FUNCTION (LAMBDA (R)
(RIPPLE-SIMULT R C1]
(SETQ RS (INTERSECTION RS RS)))
T)
(SETQ GEXISTING (GETB B PP))
(PROGN [MAPC RS (FUNCTION (LAMBDA (Z)
(APPLYB Z (QUOTE CHECK1)
BA1 BA2 BA3]
[MAPC (DREVERSE RS)
(FUNCTION (LAMBDA (Z)
(APPLYB Z (QUOTE CHECK2)
BA1 BA2 BA3]
T])
(CHECK1
[NLAMBDA (B)
(PGET (QUOTE CHECK1)
B])
(CHECK2
[NLAMBDA (B)
(PGET (QUOTE CHECK2)
B])
(D-R
[NLAMBDA (B)
(PGET (QUOTE D-R)
B])
(DEFN
[NLAMBDA (B BA1 BA2 BA3 BA4 RS C1 ATMP)
(AND (SETQ C1 (GETP (QUOTE DEFN)
(QUOTE CENT)))
(SETQ RS (REVERSE (RIPPLE-SIMULT B C1)))
(GETB B (QUOTE DEFN))
(PROG NIL
L1 (OR (AND (APPLY* (QUOTE DEFN-NOT)
(CAR RS)
BA1 BA2 BA3)
(RETURN NIL))
(AND (SETQ ATMP (APPLYB (CAR RS)
(QUOTE DEFN)
BA1 BA2 BA3))
(RETURN ATMP))
(AND (SETQ RS (CDR RS))
(GO L1))
(RETURN NIL])
(DEFN-NOT
[NLAMBDA (B BA1 BA2 BA3 BA4 RS C1 ATMP)
(AND (SETQ C1 (GETP (QUOTE DEFN-NOT)
(QUOTE CENT)))
(SETQ RS (RIPPLE-SIMULT B C1))
(GETB B (QUOTE DEFN-NOT))
(SOME-EBP RS (QUOTE DEFN-NOT)
BA1 BA2 BA3])
(DOMAIN
[NLAMBDA (B BA1 BA2 BA3 BA4 RS C1 ATMP)
(SETQ C1 (GETP (QUOTE D-R)
(QUOTE CENT)))
(AND (SETQ RS (RIPPLE-SIMULT B C1))
(GETB B (QUOTE D-R))
(PROG NIL
L1 (OR (AND (SETQ ATMP (APPLYB (CAR RS)
(QUOTE D-R)
(QUOTE DOMAIN)
BA1 BA2 BA3))
(RETURN ATMP))
(AND (SETQ RS (CDR RS))
(GO L1))
(RETURN NIL])
(EXS
[NLAMBDA (B)
(PGET (QUOTE EXS)
B])
(EXS-BDY
[NLAMBDA (B)
(PGET (QUOTE EXS-BDY)
B])
(EXS-NOT
[NLAMBDA (B)
(PGET (QUOTE EXS-NOT)
B])
(EXS-NOT-BDY
[NLAMBDA (B)
(PGET (QUOTE EXS-NOT-BDY)
B])
(FILLIN
[NLAMBDA (B BA1 BA2 BA3 BA4 RS C1 PP)
(AND (SETQ C1 (GETP (QUOTE FILLIN)
(QUOTE CENT)))
(SETQ RS (RIPPLE-SIMULT B C1))
(SETQ PP (QUOTE FILLIN))
(OR (AND BA1 (FMEMB BA1 FACETS)
(SETQ PP BA1)
[SETQ RS (MAPCONC RS (FUNCTION (LAMBDA (R)
(IS-CON-L (GLUE R BA1]
[NCONC RS (MAPCONC RS (FUNCTION (LAMBDA (R)
(RIPPLE-SIMULT R C1]
(SETQ RS (INTERSECTION RS RS)))
T)
(SETQ GEXISTING (INIT-PART B PP))
(NCONCB B PP (NCONC [MAPCONC RS (FUNCTION (LAMBDA (Z)
(APPLYB Z (QUOTE FILLIN1)
BA1 BA2 BA3]
(MAPCONC (DREVERSE RS)
(FUNCTION (LAMBDA (Z)
(APPLYB Z (QUOTE FILLIN2)
BA1 BA2 BA3])
(FILLIN1
[NLAMBDA (B)
(PGET (QUOTE FILLIN1)
B])
(FILLIN2
[NLAMBDA (B)
(PGET (QUOTE FILLIN2)
B])
(GENL
[NLAMBDA (B)
(RIPPLE B (QUOTE GENL])
(IN-DOM-OF
[NLAMBDA (B)
(PGET (QUOTE IN-DOM-OF)
B])
(IN-RAN-OF
[NLAMBDA (B)
(PGET (QUOTE IN-RAN-OF)
B])
(INIT
[NLAMBDA (B)
(PGET (QUOTE INIT)
B])
(INST
[NLAMBDA (B)
(PGET (QUOTE INST)
B])
(INT
[NLAMBDA (B BA1 BA2 BA3)
(PXEQ (QUOTE INT)
B BA1 BA2 BA3])
(INT-NOT
[NLAMBDA (B BA1 BA2 BA3)
(PXEQ (QUOTE INT-NOT)
B BA1 BA2 BA3])
(INTU
[NLAMBDA (B BA1 BA2 BA3)
(PXEQ (QUOTE INTU)
B BA1 BA2 BA3])
(INV
[NLAMBDA (B BA1 BA2 BA3 BA4)
(PXEQ (QUOTE INV)
B BA1 BA2 BA3 BA4])
(RANGE
[NLAMBDA (B BA1 BA2 BA3 BA4 RS C1 ATMP)
(SETQ C1 (GETP (QUOTE D-R)
(QUOTE CENT)))
(AND (SETQ RS (RIPPLE-SIMULT B C1))
(GETB B (QUOTE D-R))
(PROG NIL
L1 (OR (AND (SETQ ATMP (APPLYB (CAR RS)
(QUOTE D-R)
(QUOTE RANGE)
BA1 BA2 BA3))
(RETURN ATMP))
(AND (SETQ RS (CDR RS))
(GO L1))
(RETURN NIL])
(RESTRUC
[NLAMBDA (B)
(PGET (QUOTE RESTRUC)
B])
(SPEC
[NLAMBDA (B)
(RIPPLE B (QUOTE SPEC])
(SUGG
[NLAMBDA (B BA1 BA2 BA3)
(PXEQ (QUOTE SUGG)
B BA1 BA2 BA3])
(UP
[NLAMBDA (B)
(PGET (QUOTE UP)
B])
(VIEW
[NLAMBDA (B BA1 BA2 BA3 BA4 RS C1)
(SETQ C1 (GETP (QUOTE VIEW)
(QUOTE CENT)))
(AND (SETQ RS (REVERSE (RIPPLE-SIMULT B C1)))
(GETB B (QUOTE VIEW))
(SOME-EBP RS (QUOTE VIEW)
BA1 BA2 BA3 BA4])
(WORTH
[NLAMBDA (B)
(PGET (QUOTE WORTH)
B])
)
(RPAQQ AUX-FACETS (FILLIN1 FILLIN2 CHECK1 CHECK2))
(RPAQQ FILLIN1 NIL)
(RPAQQ FILLIN2 NIL)
(RPAQQ CHECK1 NIL)
(RPAQQ CHECK2 NIL)
(RPAQQ SUF-PARTS (FILLIN CHECK))
(RPAQQ STRATEGY-PARTS (FILLIN CHECK))
(RPAQQ XEQ-PARTS (DOMAIN DEFN-NOT ALGS ANAS CHECK CHECK1 CHECK2 FILLIN FILLIN1 FILLIN2 INT INT-NOT INTU INV SUGG VIEW
RESTRUC DEFN))
(RPAQQ XS-PARTS (DOMAIN DEFN-NOT VIEW ALGS ANAS CHECK1 CHECK2 DEFN FILLIN1 FILLIN2 INT INT-NOT INTU INV SUGG RESTRUC))
(RPAQQ OR-PARTS (DEFN DEFN-NOT ALGS VIEW))
(PUTPROPS ACTIVE GENL (ANYB)
SPEC (OPERATION)
WORTH (0)
DEFN (ANY-OF NIL)
UP (ANYB))
(PUTPROPS ACTIVE-D-R GENL (ANYB-D-R)
WORTH (0)
SPEC (COMPOSE-EXS-D-R COMPOSE-D-R))
(PUTPROPS ACTIVE-EXS GENL (ANYB-EXS)
WORTH (0)
SPEC (COMPOSE-EXS))
(PUTPROPS ACTIVE-INST GENL (ANYB-INST)
FILLIN1 [AND
[SETQ GTEMP8 (CAR (SOME (LIST (QUOTE ALGS)
(QUOTE DEFN)
(QUOTE INTU))
(FUNCTION (LAMBDA (P)
(GETB CS-B P]
(EVAL
(NCONC (LIST (QUOTE APPLYB)
(QUOTE CS-B)
(QUOTE GTEMP8))
(MAPCAR (ANY1OF (GETB CS-B (QUOTE D-R)))
(FUNCTION
(LAMBDA
(Z)
(KWOTE (RAND-MEMB
(OR (GETB Z (QUOTE EXS))
(APPLY* EXS Z)
(PROG1 (CPRIN1 4
" Sigh. Have to give up filling in an INSTANCE of "
CS-B
", because I can't find an example of a " Z
CRLF)
(ADD-CANDS (LIST (LIST CS-INT (QUOTE FILLIN)
Z
(QUOTE EXS]
SUGG [APPEND (MAPCONC CONCEPTS
(FUNCTION (LAMBDA (C)
(AND (ISA C (QUOTE ACTIVE))
(OR (GETB C (QUOTE DEFN))
(GETB C (QUOTE INTU))
(GETB C (QUOTE ALGS)))
(NULL (GETB C (QUOTE INST)))
(LIST (LIST [FIX (DOTPROD (LIST .7 .1 .1 .1)
(GETB C (QUOTE WORTH]
(QUOTE FILLIN)
C
(QUOTE INST]
WORTH (0)
INIT (ANY-OF NIL)
SPEC NIL)
(PUTPROPS ANYB GENL NIL
INT (IPLUS 0)
WORTH (0)
VIEW (ANY-OF [PROG1 NIL (SETQ GTEMP5 (RIPPLE BA1 (QUOTE GENL]
[AND (FMEMB (QUOTE STRUCTURE)
GTEMP5)
(LIST (APPLYB (QUOTE STRUCTURE-INSERT)
(QUOTE ALGS)
(COPY BA2)
NIL
(CAR (INTERSECTION (SPEC STRUCTURE)
GTEMP5]
(AND (FMEMB (QUOTE ORD-PAIR)
GTEMP5)
(LIST (QUOTE PAIR)
BA2 BA2)))
EXS (ANY-OF NIL ACTIVE)
SPEC (ACTIVE ANYB-ANYP OBJECT))
(PUTPROPS ANYB-ANAS GENL (ANYB-ANYP)
WORTH (0)
INIT (ANY-OF NIL)
SPEC NIL)
(PUTPROPS ANYB-ANYP GENL (ANYB)
FILLIN1 (APPEND (APPLY (QUOTE UNION)
(APPLYB CS-B (QUOTE ANAS)
CS-P)))
CHECK2 [AND (PROG1 T (ADD-CANDS (LIST (LIST (RMUL CS-INT 1 2)
(QUOTE RESTRUC)
CS-B CS-P]
WORTH (0)
SPEC (ANYB-ANAS ANYB-CHECK ANYB-CHECK1 ANYB-CHECK2 ANYB-D-R ANYB-DEFN ANYB-DEFN-NOT ANYB-DOMAIN
ANYB-EXS ANYB-EXS-BDY ANYB-EXS-NOT ANYB-EXS-NOT-BDY ANYB-FILLIN ANYB-FILLIN1
ANYB-FILLIN2 ANYB-GENL ANYB-IN-DOM-OF ANYB-IN-RAN-OF ANYB-INIT ANYB-INT
ANYB-INT-NOT ANYB-INTU ANYB-INV ANYB-RANGE ANYB-RESTRUC ANYB-SPEC ANYB-SUGG
ANYB-UP ANYB-VIEW ANYB-WORTH))
(PUTPROPS ANYB-CHECK GENL (ANYB-ANYP)
WORTH (0)
INIT (ANY-OF NIL)
SPEC NIL)
(PUTPROPS ANYB-CHECK1 GENL (ANYB-ANYP)
SPEC NIL)
(PUTPROPS ANYB-CHECK2 GENL (ANYB-ANYP)
SPEC NIL)
(PUTPROPS ANYB-D-R GENL (ANYB-ANYP)
WORTH (0)
INIT (OSET)
SPEC (ACTIVE-D-R))
(PUTPROPS ANYB-DEFN GENL (ANYB-ANYP)
WORTH (0)
INIT (ANY-OF NIL)
SPEC NIL)
(PUTPROPS ANYB-DEFN-NOT GENL (ANYB-ANYP)
INIT (ANY-OF NIL)
SPEC NIL)
(PUTPROPS ANYB-DOMAIN GENL (ANYB-ANYP)
SPEC NIL)
(PUTPROPS ANYB-EXS GENL (ANYB-ANYP)
FILLIN1 (APPEND (INSTAN-S (GETB CS-B (QUOTE SPEC))
BA1)
(INSTAN-D (GETB CS-B (QUOTE DEFN))
BA1)
(INSTAN-I (GETB CS-B (QUOTE INTU))
BA1))
FILLIN2 [APPEND (PROG1 NIL (SORT (GETB CS-B (QUOTE EXS))
(QUOTE COUNT))
[AND ORIG-EMP GEXISTING
(OR [MAPC (APPLY* (QUOTE IN-DOM-OF)
CS-B)
(FUNCTION (LAMBDA (B1)
(OR (GETB B1 (QUOTE EXS))
(INCRB B1 (QUOTE EXS)
(NCONC1 (COPY (COMMENT EXS OF
YOUR
DOMAIN ARE
ON))
CS-B]
(MAPC (APPLY* (QUOTE IN-RAN-OF)
CS-B)
(FUNCTION (LAMBDA (B1)
(OR (GETB B1 (QUOTE EXS))
(INCRB B1 (QUOTE EXS)
(NCONC1 (COPY (COMMENT EXS OF
YOUR
RANGE ARE
ON))
CS-B]
[ADD-CANDS (LIST (LIST (RMUL CS-INT 3 4)
(QUOTE CHECK)
CS-B
(QUOTE EXS]
(COND ([SETQ GTEMP9 (INT-ENUF (GETB CS-B (QUOTE INT]
(SETQ ILEV (AVG2 CS-INT 500))
[CREATEB (SETQ NEWB (PACK (LIST (QUOTE INTERESTING-)
CS-B]
(SETB NEWB (QUOTE GENL)
(LIST CS-B))
(SETB NEWB (QUOTE DEFN)
(NCONC [LIST (QUOTE AND)
(LIST (QUOTE APPLYB)
(KWOTE CS-B)
(KWOTE (QUOTE DEFN]
GTEMP9))
(SETB NEWB (QUOTE WORTH)
(PROGN [SETQ GTEMP4 (COPY (GETB CS-B (QUOTE WORTH]
(SET-NTH GTEMP4 1 NEW-ILEV)
[SET-NTH GTEMP4 11
(LIST (QUOTE COND)
(LIST (LIST (QUOTE GETB)
NEWB
(KWOTE (QUOTE EXS)))
(ADD1 (CAR (FNTH GTEMP4 11]
GTEMP4))
(ADD-CANDS (LIST (LIST (SUB1 CS-INT)
(QUOTE FILLIN)
NEWB
(QUOTE EXS]
CHECK1 [AND (PROG1 T (MAPC GEXISTING (FUNCTION (LAMBDA (X1)
(COND ((AND (GETB CS-B (QUOTE DEFN))
(NOT (APPLYB CS-B (QUOTE DEFN)
X1)))
(GTRANSFER X1 (QUOTE NOT-BDY)))
((AND (GETB CS-B (QUOTE INTU))
(NOT (APPLYB CS-B (QUOTE INTU)
X1)))
(GTRANSFER X1 (QUOTE BDY]
SUGG [APPEND [MAPCONC PAST (FUNCTION (LAMBDA (PE)
(COND ((EQ (P-P PE)
(QUOTE EXS))
(LIST (LIST (COND ((NUMBERP (PINT PE))
(RMUL (PINT PE)
1 2))
(T 250))
(QUOTE RE-JUDGE)
(P-B PE)
(QUOTE EXS]
(MAPCONC CONCEPTS (FUNCTION (LAMBDA
(C)
(AND (NULL (GETB C (QUOTE EXS)))
(LIST (LIST [FIX (DOTPROD (LIST .7 .1 .1 .1)
(GETB C (QUOTE WORTH]
(QUOTE FILLIN)
C
(QUOTE EXS]
WORTH (0)
INIT (ANY-OF NIL)
CHECK2 [AND (SETQ GEXISTING (SETB CS-B (QUOTE EXS)
(APPEND (GETB (QUOTE ANYB-EXS)
(QUOTE INIT))
(APPLYB (QUOTE SET-STRUC-DIFF)
(QUOTE ALGS)
(APPLYB (QUOTE SET-STRUC-INTERSECT)
(QUOTE ALGS)
(GETB CS-B (QUOTE EXS))
(GETB CS-B (QUOTE EXS)))
(GETB CS-B (QUOTE EXS-BDY]
SPEC (ACTIVE-EXS OBJECT-EXS STRUCTURE-EXS))
(PUTPROPS ANYB-EXS-BDY GENL (ANYB-ANYP)
CHECK1 [AND (PROG1 T (MAPC GEXISTING (FUNCTION (LAMBDA (X1)
(COND
[(FMEMB X1 (LIST NIL (QUOTE ANY1OF)
(QUOTE ANY-OF]
((AND (GETB CS-B (QUOTE DEFN))
(NOT (APPLYB CS-B (QUOTE DEFN)
X1)))
(GTRANSFER X1 (QUOTE NOT-BDY)))
((AND (GETB CS-B (QUOTE INTU))
(NOT (APPLYB CS-B (QUOTE INTU)
X1)))
(GTRANSFER X1 (QUOTE BDY]
SUGG [APPEND (MAPCONC CONCEPTS (FUNCTION
(LAMBDA (C)
(AND (NULL (GETB C (QUOTE EXS-BDY)))
(LIST (LIST [FIX (DOTPROD (LIST .3 .1 .1)
(GETB C (QUOTE WORTH]
(QUOTE FILLIN)
C
(QUOTE EXS-BDY]
WORTH (0)
INIT (ANY-OF NIL)
CHECK2 [AND (SETQ GEXISTING (SETB CS-B (QUOTE EXS-BDY)
(APPEND (GETB (QUOTE ANYB-EXS-BDY)
(QUOTE INIT))
(APPLYB (QUOTE SET-STRUC-INTERSECT)
(QUOTE ALGS)
(GETB CS-B (QUOTE EXS-BDY))
(GETB CS-B (QUOTE EXS-BDY]
SPEC (STRUCTURE-EXS-BDY))
(PUTPROPS ANYB-EXS-NOT GENL (ANYB-ANYP)
WORTH (0)
INIT (ANY-OF NIL)
SPEC NIL)
(PUTPROPS ANYB-EXS-NOT-BDY GENL (ANYB-ANYP)
WORTH (0)
INIT (ANY-OF NIL)
SPEC NIL)
(PUTPROPS ANYB-FILLIN GENL (ANYB-ANYP)
WORTH (0)
INIT (ANY-OF NIL)
SPEC NIL)
(PUTPROPS ANYB-FILLIN1 GENL (ANYB-ANYP)
SPEC NIL)
(PUTPROPS ANYB-FILLIN2 GENL (ANYB-ANYP)
SPEC NIL)
(PUTPROPS ANYB-GENL GENL (ANYB-ANYP)
WORTH (0)
INIT NIL
SPEC NIL)
(PUTPROPS ANYB-IN-DOM-OF GENL (ANYB-ANYP)
SPEC NIL)
(PUTPROPS ANYB-IN-RAN-OF GENL (ANYB-ANYP)
SPEC NIL)
(PUTPROPS ANYB-INIT GENL (ANYB-ANYP)
SPEC NIL)
(PUTPROPS ANYB-INST GENL (ANYB-ANYP)
INIT (ANY-OF NIL)
SPEC NIL)
(PUTPROPS ANYB-INT GENL (ANYB-ANYP)
WORTH (0)
INIT (ANY-OF NIL)
SPEC NIL)
(PUTPROPS ANYB-INT-NOT GENL (ANYB-ANYP)
WORTH (0)
INIT (ANY-OF NIL)
SPEC NIL)
(PUTPROPS ANYB-INTU GENL (ANYB-ANYP)
WORTH (0)
INIT (ANY-OF NIL)
SPEC NIL)
(PUTPROPS ANYB-INV GENL (ANYB-ANYP)
INIT (ANY-OF NIL)
SPEC NIL)
(PUTPROPS ANYB-RANGE GENL (ANYB-ANYP)
SPEC NIL)
(PUTPROPS ANYB-RESTRUC GENL (ANYB-ANYP)
WORTH (0)
INIT (ANY-OF NIL)
SPEC NIL)
(PUTPROPS ANYB-SPEC GENL (ANYB-ANYP)
WORTH (0)
INIT NIL
SPEC NIL)
(PUTPROPS ANYB-SUGG GENL (ANYB-ANYP)
WORTH (0)
INIT (ANY-OF NIL)
SPEC NIL)
(PUTPROPS ANYB-UP GENL (ANYB-ANYP)
WORTH (0)
INIT (ANY-OF NIL)
SPEC NIL)
(PUTPROPS ANYB-VIEW GENL (ANYB-ANYP)
INIT (ANY-OF NIL)
SPEC NIL)
(PUTPROPS ANYB-WORTH GENL (ANYB-ANYP)
WORTH (0)
INIT (ANY-OF NIL)
SPEC NIL)
(PUTPROPS ANYTHING GENL NIL
WORTH (0)
DEFN (ANY1OF (TYPE TRIVIAL CONSTANT T))
ALGS (ANY1OF (TYPE TRIVIAL CONSTANT T))
SPEC NIL)
(PUTPROPS BAG-STRUC GENL (UNORD-OBJ MULT-STRUC)
WORTH (300 200 700 500 400 990 900 1000 800 800 1000)
DEFN [ANY1OF (TYPE NONRECURSIVE (MATCH BA1 WITH ('BAG $)))
(TYPE RECURSIVE (COND [(EQUAL BA1 (LIST (QUOTE BAG]
((NOT (AND (LISTP BA1)
(CDR BA1)))
NIL)
((APPLYB (QUOTE BAG-STRUC)
(QUOTE DEFN)
(APPLYB (QUOTE STRUCTURE-DELETE)
(QUOTE ALGS)
(APPLYB (QUOTE STRUCTURE-MEMB)
(QUOTE ALGS)
NIL
(COPY BA1))
(COPY BA1]
INTU [ANY1OF (CONS (QUOTE BAG)
(RAND-SUBSET USERNAMES))
(CONS (QUOTE BAG)
(APPEND (SETQ RB1 (RAND-SUBSET USERNAMES))
(RAND-SUBSET RB1)))
(CONS (QUOTE BAG)
(RAND-PERMUTE (RAND-SUBSET USERNAMES]
DEFN-NOT [ANY-OF (TYPE NONRECURSIVE (NEQ (CAR BA1)
(QUOTE BAG]
IN-DOM-OF (BAG-STRUC-INSERT)
SPEC NIL)
(PUTPROPS BAG-STRUC-DELETE GENL (STRUCTURE-DELETE)
WORTH (0)
ALGS [ANY1OF [TYPE NONRECURSIVE (AND (SETQ GTEMP7 (FMEMB BA1 (CDR BA2)))
(COND ((CDR GTEMP7)
(RPLACA GTEMP7 (APPEND (CADR GTEMP7)))
(RPLACD GTEMP7 (CDDR GTEMP7)))
((RPLACD BA2 (DREMOVE BA1 (CDR BA2]
(TYPE RECURSIVE (COND ((NULL (CADR BA2))
BA2)
(T (SETQ BA3 (CADR BA2))
(RPLACD BA2 (CDDR BA2))
(COND ((APPLYB (QUOTE OBJ-EQUAL)
(QUOTE ALGS)
BA1 BA3)
BA2)
(T (APPLYB (QUOTE BAG-STRUC-INSERT)
(QUOTE ALGS)
BA3
(APPLYB (QUOTE BAG-STRUC-DELETE)
(QUOTE ALGS)
BA1 BA2]
UP (BAG-STRUC-IN-DOM-OF)
INV (TYPE NONRECURSIVE TRANSFORM (APPLYB (QUOTE STRUCTURE-DELETE)
(QUOTE INV)
BA1 BA2 (QUOTE BAG-STRUC)))
D-R (OSET (ANYTHING BAG-STRUC BAG-STRUC))
SPEC NIL)
(PUTPROPS BAG-STRUC-INSERT GENL (STRUCTURE-INSERT)
WORTH (0)
ALGS [ANY1OF (TYPE NONRECURSIVE OPAQUE QUICK
(AND [OR BA2 [SETQ BA2 (LIST (CAAR (LAST (GETB (QUOTE BAG-STRUC)
(QUOTE EXS]
(BOOST (LIST (QUOTE FILLIN)
(QUOTE BAG-STRUC)
(QUOTE EXS]
(OR BA1 (SETQ BA1 (RAND-THING)))
(ATTACH (CAR BA2)
(MERGE (LIST BA1)
(CDR BA2)
(QUOTE SORD]
UP (BAG-STRUC-IN-DOM-OF)
D-R (OSET (ANYTHING BAG-STRUC BAG-STRUC))
SPEC NIL)
(PUTPROPS COMPOSE GENL (OPERATION)
WORTH (250 150 700 500 400 990 900 1000 800 800 1000)
D-R (OSET (OPERATION OPERATION OPERATION)
(RELATION RELATION RELATION)
(PREDICATE ACTIVE PREDICATE)
(ACTIVE ACTIVE ACTIVE))
DEFN [TYPE NONRECURSIVE (AND (ISA BA1 (QUOTE ACTIVE))
(ISA BA2 (QUOTE ACTIVE))
(ISA BA3 (QUOTE ACTIVE))
(ARE-EQUIV BA3 (APPLYB (QUOTE COMPOSE)
(QUOTE ALGS)
BA1 BA2]
ALGS [ANY1OF (TYPE QUASIRECURSIVE CASES (PROGN [COND
((NULL BA1)
(APPLYB (QUOTE COMPOSE)
(QUOTE ALGS)
(RAND-MEMB (EXS ACTIVE))
BA2 BA3 BA4))
((NULL BA2)
(APPLYB (QUOTE COMPOSE)
(QUOTE ALGS)
BA1
(RAND-MEMB (EXS ACTIVE))
BA3 BA4))
((GETHASH (SETQ GTEMP12 (GLUEC BA1 BA2))
HCON))
([SETQ
GTEMP11
(SOME (EXS COMPOSE)
(FUNCTION
(LAMBDA
(Z)
(MEMBER (LIST (QUOTE EQUAL)
(QUOTE BA3)
(LIST (QUOTE APPLYB)
(Q ALGS)
BA1 BA2
(QUOTE BA1)
(QUOTE BA2)))
(GETB Z (QUOTE DEFN]
(SETQ GTEMP12 GTEMP11))
((AND BA1 BA2 (GETHASH BA1 HCON)
(GETHASH BA2 HCON)
(ISA BA1 (QUOTE ACTIVE))
(ISA BA2 (QUOTE ACTIVE)))
(CREATEB GTEMP12)
[SETB GTEMP12 (QUOTE DEFN)
(LIST (QUOTE ANY1OF)
(LIST (QUOTE APPLYB)
(Q COMPOSE)
(Q ALGS)
BA1 BA2 (QUOTE BA1)
(QUOTE BA2]
(SETQ GTEMP11 (CON-MERGE-ARGS BA1 BA2 GTEMP12))
(SETB GTEMP12 (QUOTE ARGS)
(CAR GTEMP11))
(SETB GTEMP12 (QUOTE ALGS)
(CONS (QUOTE ANY1OF)
(CDR GTEMP11)))
(SETB GTEMP12 (QUOTE WORTH)
(LIST 100 CS-INT 10 10 10]
(COND ((AND (OR BA3 BA4)
(GETHASH GTEMP12 HCON))
(APPLYB GTEMP12 (QUOTE ALGS)
BA3 BA4))
(T GTEMP12]
UP (OPERATION)
SPEC NIL)
(PUTPROPS COMPOSE-D-R GENL (ACTIVE-D-R)
WORTH (0)
FILLIN1 [APPEND (PROGN (ARGS-ASA COMPOSE F1 F2)
(CADAR (CON-MERGE-ARGS F1 F2]
SPEC NIL)
(PUTPROPS COMPOSE-EXS GENL (ACTIVE-EXS)
WORTH (100 75 100 100 50)
FILLIN (ANY-OF (OR BA1 BA2 (ALGS CS-B)))
SPEC NIL)
(PUTPROPS COMPOSE-EXS-D-R GENL (ACTIVE-D-R)
WORTH (0)
FILLIN1 (APPEND (PROGN (ARGS-ASA COMPOSE F1 F2)
[SETQ RAN1 (LAST (CAR (GETB F1 (QUOTE D-R]
(SETQ DOM1 (LDIFF (CAR (GETB F1 (QUOTE D-R)))
RAN1))
[SETQ RAN2 (LAST (CAR (GETB F2 (QUOTE D-R]
(SETQ DOM2 (LDIFF (CAR (GETB F2 (QUOTE D-R)))
RAN2))
[SETQ DOM3 (AND (CDR DOM1)
(LIST (CADR (MIN2 (APPEND RAN2 RAN2 RAN2 RAN2)
DOM1
(QUOTE FRAC-INCLU]
(APPEND DOM2 DOM3 RAN1)))
SPEC NIL)
(PUTPROPS CONSTRUCTIVE GENL (PREDICATE)
WORTH (0)
DEFN [ANY1OF (TYPE QUASIRECURSIVE (OR (FMEMB BA1 CONSTRUCTIVE-OPS)
(RIPPLE-UNTIL BA1 (QUOTE GENL)
(LIST (QUOTE FMEMB)
(QUOTE B)
(QUOTE CONSTRUCTIVE-OPS]
SPEC NIL)
(PUTPROPS FINAL WORTH (0)
ALGS [ANY1OF (TYPE NONRECURSIVE (COND ((AND BA2 (CDR BA1))
(FRPLACA (LAST BA1)
BA2))
(T (CAR (LAST (CDR BA1]
UP (BAG-STRUC-IN-DOM-OF OPERATION)
DEFN [ANY-OF (TYPE QUASIRECURSIVE (EQUAL BA2 (APPLYB (QUOTE FINAL)
(QUOTE ALGS)
BA1]
GENL (OPERATION)
D-R (OSET (ORD-OBJ ANYTHING))
SPEC NIL)
(PUTPROPS FIRST WORTH (0)
ALGS [ANY1OF (TYPE NONRECURSIVE (COND (BA2 (FSET-NTH BA1 2 BA2))
(T (CADR BA1]
UP (BAG-STRUC-IN-DOM-OF OPERATION)
DEFN [ANY-OF (TYPE QUASIRECURSIVE (EQUAL BA2 (APPLYB (QUOTE FIRST)
(QUOTE ALGS)
BA1]
GENL (OPERATION)
D-R (OSET (ORD-OBJ ANYTHING))
SPEC NIL)
(PUTPROPS LIST-STRUC GENL (ORD-OBJ MULT-STRUC)
WORTH (300 200 700 500 400 990 900 1000 800 800 1000)
DEFN [ANY1OF (TYPE NONRECURSIVE (MATCH BA1 WITH ('VECTOR $)))
(TYPE RECURSIVE (COND [(EQUAL BA1 (LIST (QUOTE VECTOR]
((NOT (AND (LISTP BA1)
(CDR BA1)))
NIL)
((APPLYB (QUOTE LIST-STRUC)
(QUOTE DEFN)
(APPLYB (QUOTE STRUCTURE-DELETE)
(QUOTE ALGS)
(APPLYB (QUOTE STRUCTURE-MEMB)
(QUOTE ALGS)
NIL
(COPY BA1))
(COPY BA1]
INTU [ANY1OF (CONS (QUOTE VECTOR)
(RAND-SUBSET USERNAMES))
(CONS (QUOTE VECTOR)
(APPEND (SETQ RB1 (RAND-SUBSET USERNAMES))
(RAND-SUBSET RB1)))
(CONS (QUOTE VECTOR)
(RAND-PERMUTE (RAND-SUBSET USERNAMES]
IN-DOM-OF (LIST-STRUC-INSERT FIRST REAR FINAL)
EXS (ANY-OF NIL (VECTOR (VECTOR))
(VECTOR (CLASS DOUG))
(VECTOR DOUG ED BRUCE)
(VECTOR DOUG)
(VECTOR ED)
(VECTOR DOUG ED)
(VECTOR ED DOUG)
(VECTOR DOUG DOUG)
(VECTOR ED ED)
(VECTOR DOUG ED ED)
(VECTOR DOUG ED DOUG)
(VECTOR DOUG DOUG ED)
(VECTOR ED ED ED)
(VECTOR DOUG DOUG DOUG)
(VECTOR ED ED DOUG)
(VECTOR ED DOUG ED)
(VECTOR ED DOUG DOUG))
EXS-BDY (ANY-OF NIL (VECTOR))
DEFN-NOT [ANY-OF (TYPE NONRECURSIVE (NEQ (CAR BA1)
(QUOTE VECTOR]
VIEW (ANY-OF NIL)
SPEC NIL)
(PUTPROPS LIST-STRUC-DELETE GENL (STRUCTURE-DELETE)
WORTH (0)
ALGS [ANY1OF (TYPE RECURSIVE (COND ((NULL (CADR BA2))
BA2)
(T (SETQ BA3 (CADR BA2))
(RPLACD BA2 (CDDR BA2))
(COND ((APPLYB (QUOTE OBJ-EQUAL)
(QUOTE ALGS)
BA1 BA3)
BA2)
(T (APPLYB (QUOTE STRUCTURE-INSERT)
(QUOTE ALGS)
BA3
(APPLYB (QUOTE LIST-STRUC-DELETE)
(QUOTE ALGS)
BA1 BA2]
UP (LIST-STRUC-IN-DOM-OF)
INV (TYPE NONRECURSIVE TRANSFORM (APPLYB (QUOTE STRUCTURE-DELETE)
(QUOTE INV)
BA1 BA2 (QUOTE LIST-STRUC)))
D-R (OSET (ANYTHING LIST-STRUC LIST-STRUC))
SPEC NIL)
(PUTPROPS LIST-STRUC-INSERT GENL (STRUCTURE-INSERT)
WORTH (0)
ALGS [ANY1OF (TYPE NONRECURSIVE OPAQUE QUICK
(AND [OR BA2 (SETQ BA2 (LIST (CAAR (LAST (GETB (QUOTE LIST-STRUC)
(QUOTE EXS]
(OR BA1 (SETQ BA1 (RAND-THING)))
(ATTACH (CAR BA2)
(FRPLACA BA2 BA1]
UP (LIST-STRUC-IN-DOM-OF)
D-R (OSET (ANYTHING LIST-STRUC LIST-STRUC))
SPEC NIL)
(PUTPROPS MULT-STRUC GENL (STRUCTURE)
SPEC NIL
WORTH (0))
(PUTPROPS NONMULT-STRUC GENL (STRUCTURE)
SPEC NIL
WORTH (0))
(PUTPROPS OBJ-EQUAL GENL (OPERATION)
WORTH (0)
ALGS [ANY1OF (TYPE NONRECURSIVE OPAQUE (EQUAL BA1 BA2))
(TYPE RECURSIVE (COND ((AND (NLISTP (CDR BA1))
(NLISTP (CDR BA2)))
(EQ (CAR BA1)
(CAR BA2)))
((OR (NLISTP (CDR BA1))
(NLISTP (CDR BA2)))
NIL)
(T (AND (APPLYB (QUOTE OBJ-EQUAL)
(QUOTE ALGS)
(APPLYB (QUOTE FIRST)
(QUOTE ALGS)
BA1)
(APPLYB (QUOTE FIRST)
(QUOTE ALGS)
BA2))
(APPLYB (QUOTE OBJ-EQUAL)
(QUOTE ALGS)
(APPLYB (QUOTE REAR)
(QUOTE ALGS)
BA1)
(APPLYB (QUOTE REAR)
(QUOTE ALGS)
BA2]
UP (OPERATION STRUCTURE-IN-DOM-OF)
SPEC (OSET-STRUC-EQUAL LIST-STRUC-EQUAL STRUCTURE-EQUAL)
D-R (OSET (OBJECT OBJECT TRUTH-VAL)))
(PUTPROPS OBJECT GENL (ANYB)
SPEC (ORD-OBJ TRUTH-VAL UNORD-OBJ)
WORTH (0))
(PUTPROPS OBJECT-EXS GENL (ANYB-EXS)
WORTH (0)
SPEC (ORD-OBJ-EXS UNORD-OBJ-EXS))
(PUTPROPS OPERATION GENL (ACTIVE)
WORTH (0)
EXS (ANY-OF NIL STRUCTURE-DELETE COMPOSE FINAL FIRST OBJ-EQUAL REAR STRUCTURE-DIFF
STRUCTURE-EQUAL STRUCTURE-INSERT STRUCTURE-INTERSECT STRUCTURE-MEMB)
SPEC (COMPOSE FINAL FIRST OBJ-EQUAL REAR STRUCTURE-DELETE STRUCTURE-DIFF STRUCTURE-INSERT
STRUCTURE-INTERSECT STRUCTURE-MEMB))
(PUTPROPS ORD-OBJ GENL (OBJECT)
SPEC (ORD-PAIR)
WORTH (0))
(PUTPROPS ORD-OBJ-EXS GENL (OBJECT-EXS)
WORTH (0)
CHECK1 [AND (GETHASH [SETQ GTEMP4 (PACK (LIST CS-B (QUOTE -INSERT]
HCON)
(SETQ GEXISTING (SETB CS-B (QUOTE EXS)
(APPEND (GETB (QUOTE ANYB-EXS)
(QUOTE INIT))
[MAPCAR (GETB CS-B (QUOTE EXS))
(FUNCTION (LAMBDA (Z)
(CONS (CAR Z)
(RAND-PERMUTE
(CDR Z]
(GETB CS-B (QUOTE EXS]
SPEC NIL)
(PUTPROPS ORD-PAIR GENL (OBJECT ORD-OBJ)
INT (IPLUS 0)
IN-DOM-OF (REV-PAIR FIRST FINAL)
WORTH (75 200 700 500 400 990 900 1000 800 800 (COND ((GETB INTERESTING-ORD-PAIR (QUOTE EXS))
801)))
DEFN [ANY1OF (TYPE NONRECURSIVE (MATCH BA1 WITH ('PAIR & &]
VIEW [ANY-OF [PROG1 NIL (SETQ GTEMP5 (RIPPLE BA1 (QUOTE GENL]
(AND (FMEMB (QUOTE STRUCTURE)
GTEMP5)
(LIST (CAR (INTERSECTION (SPEC STRUCTURE)
GTEMP5))
(APPLYB (QUOTE FIRST)
(QUOTE ALGS)
BA2)
(APPLYB (QUOTE FINAL)
(QUOTE ALGS)
BA2]
INTU (ANY1OF (LIST (QUOTE PAIR)
(RAND-MEMB USERNAMES)
(RAND-MEMB USERNAMES))
(LIST (QUOTE PAIR)
(RAND-THING)
(RAND-THING))
(LIST (QUOTE PAIR)
(SETQ RB1 (RAND-THING))
RB1))
DEFN-NOT [ANY-OF (TYPE NONRECURSIVE (NLISTP BA1))
(TYPE NONRECURSIVE (NEQ (CAR BA1)
(QUOTE PAIR]
SPEC NIL)
(PUTPROPS OSET-STRUC GENL (ORD-OBJ NONMULT-STRUC)
WORTH (300 200 700 500 400 990 900 1000 800 800 1000)
DEFN [ANY1OF (TYPE NONRECURSIVE (MATCH BA1 WITH ('OSET $)))
(TYPE RECURSIVE (COND [(EQUAL BA1 (LIST (QUOTE OSET]
((NOT (AND (LISTP BA1)
(CDR BA1)))
NIL)
((APPLYB (QUOTE OSET-STRUC)
(QUOTE DEFN)
(APPLYB (QUOTE STRUCTURE-DELETE)
(QUOTE ALGS)
(APPLYB (QUOTE STRUCTURE-MEMB)
(QUOTE ALGS)
NIL
(COPY BA1))
(COPY BA1]
INTU [ANY1OF (CONS (QUOTE OSET)
(RAND-SUBSET USERNAMES))
(CONS (QUOTE OSET)
(RAND-PERMUTE (RAND-SUBSET USERNAMES]
IN-DOM-OF (OSET-STRUC-INSERT FIRST REAR FINAL)
DEFN-NOT [ANY-OF (TYPE NONRECURSIVE (NEQ (CAR BA1)
(QUOTE OSET]
SPEC NIL)
(PUTPROPS OSET-STRUC-DELETE GENL (STRUCTURE-DELETE)
WORTH (0)
ALGS [ANY1OF (TYPE RECURSIVE (COND ((NULL (CDR BA2))
BA2)
(T (SETQ BA4 (CADR BA2))
(RPLACD BA2 (CDDR BA2))
(SETQ BA2 (APPLYB (QUOTE OSET-STRUC-DELETE)
(QUOTE ALGS)
BA1 BA2))
(COND ((APPLYB (QUOTE OBJ-EQUAL)
(QUOTE ALGS)
BA1 BA4)
BA2)
(T (APPLYB (QUOTE STRUCTURE-INSERT)
(QUOTE ALGS)
BA4 BA2]
UP (OSET-STRUC-IN-DOM-OF)
INV (TYPE NONRECURSIVE TRANSFORM (APPLYB (QUOTE STRUCTURE-DELETE)
(QUOTE INV)
BA1 BA2 (QUOTE OSET-STRUC)))
D-R (OSET (ANYTHING OSET-STRUC OSET-STRUC))
SPEC NIL)
(PUTPROPS OSET-STRUC-INSERT GENL (STRUCTURE-INSERT)
WORTH (0)
ALGS (ANY1OF (TYPE NONRECURSIVE OPAQUE QUICK
(AND [OR BA2 [SETQ BA2 (LIST (CAAR (LAST (GETB (QUOTE OSET-STRUC)
(QUOTE EXS]
(BOOST (LIST (QUOTE FILLIN)
(QUOTE OSET-STRUC)
(QUOTE EXS]
(OR BA1 (NOT (FMEMB (SETQ BA1 (RAND-THING))
BA2))
(SETQ BA1 (COPY BA2)))
(OR (FMEMB BA1 (CDR BA2))
(ATTACH (CAR BA2)
(FRPLACA BA2 BA1)))
BA2)))
UP (OSET-STRUC-IN-DOM-OF)
D-R (OSET (ANYTHING OSET-STRUC OSET-STRUC))
SPEC NIL)
(PUTPROPS PREDICATE GENL (ACTIVE)
WORTH (0)
D-R (OSET (ANYTHING TRUTH-VAL))
SPEC (CONSTRUCTIVE))
(PUTPROPS REAR WORTH (0)
ALGS [ANY1OF (TYPE NONRECURSIVE (COND [BA2 (CONS (CAR BA1)
(CONS (CADR BA1)
(CDR BA2]
(T (CONS (CAR BA1)
(CDDR BA1]
UP (STRUCTURE-IN-DOM-OF OPERATION)
DEFN (ANY-OF (TYPE QUASIRECURSIVE (APPLYB (QUOTE OBJ-EQUAL)
(QUOTE ALGS)
(APPLYB (QUOTE REAR)
(QUOTE ALGS)
BA1)
BA2)))
GENL (OPERATION)
D-R (OSET (ORD-OBJ ORD-OBJ))
SPEC NIL)
(PUTPROPS RELATION GENL (ACTIVE)
WORTH (0)
SPEC NIL)
(PUTPROPS SET-STRUC GENL (UNORD-OBJ NONMULT-STRUC)
WORTH (800 800 700 500 400 990 900 1000 800 800 1000)
DEFN [ANY1OF (TYPE NONRECURSIVE (MATCH BA1 WITH ('CLASS $)))
(TYPE RECURSIVE (COND [(EQUAL BA1 (LIST (QUOTE CLASS]
((NOT (AND (LISTP BA1)
(CDR BA1)))
NIL)
((APPLYB (QUOTE SET-STRUC)
(QUOTE DEFN)
(APPLYB (QUOTE STRUCTURE-DELETE)
(QUOTE ALGS)
(APPLYB (QUOTE STRUCTURE-MEMB)
(QUOTE ALGS)
NIL
(COPY BA1))
(COPY BA1]
INTU [ANY1OF (CONS (QUOTE CLASS)
(RAND-SUBSET USERNAMES))
(CONS (QUOTE CLASS)
(RECTANGLE (RAND 0 7)
(RAND 0 7)
(RAND 0 7)
(RAND 0 7]
IN-DOM-OF (SET-STRUC-INSERT)
DEFN-NOT [ANY-OF (TYPE NONRECURSIVE (NEQ (CAR BA1)
(QUOTE CLASS]
VIEW (ANY-OF NIL)
SPEC NIL)
(PUTPROPS SET-STRUC-DELETE GENL (STRUCTURE-DELETE)
WORTH (0)
ALGS [ANY1OF (TYPE RECURSIVE (COND ((NULL (CDR BA2))
BA2)
(T (SETQ BA4 (CADR BA2))
(RPLACD BA2 (CDDR BA2))
(SETQ BA2 (APPLYB (QUOTE SET-STRUC-DELETE)
(QUOTE ALGS)
BA1 BA2))
(COND ((APPLYB (QUOTE OBJ-EQUAL)
(QUOTE ALGS)
BA1 BA4)
BA2)
(T (APPLYB (QUOTE STRUCTURE-INSERT)
(QUOTE ALGS)
BA4 BA2]
UP (SET-STRUC-IN-DOM-OF)
INV (TYPE NONRECURSIVE TRANSFORM (APPLYB (QUOTE STRUCTURE-DELETE)
(QUOTE INV)
BA1 BA2 (QUOTE SET-STRUC)))
D-R (OSET (ANYTHING SET-STRUC SET-STRUC))
SPEC NIL)
(PUTPROPS SET-STRUC-DIFF GENL (STRUCTURE-DIFF)
WORTH (0)
ALGS (ANY1OF [TYPE NONRECURSIVE (SUBSET BA1 (FUNCTION (LAMBDA (Z)
(NOT (APPLYB (QUOTE
STRUCTURE-MEMB)
(QUOTE ALGS)
Z BA2]
(TYPE RECURSIVE (PROGN [COND ((SETQ BA4 (APPLYB (QUOTE STRUCTURE-MEMB)
(QUOTE ALGS)
NIL BA2))
(SETQ BA1 (APPLYB (QUOTE STRUCTURE-DELETE)
(QUOTE ALGS)
BA4 BA1))
(SETQ BA1 (APPLYB (QUOTE SET-INTERSECT'ALGS)
BA1 BA2))
(AND (NOT (APPLYB (QUOTE STRUCTURE-MEMB)
(QUOTE ALGS)
BA4 BA2))
(APPLYB (QUOTE SET-STRUC-INSERT)
BA4 BA1]
BA1)))
UP (SET-STRUC-IN-DOM-OF)
D-R (OSET (SET-STRUC SET-STRUC SET-STRUC))
SPEC NIL)
(PUTPROPS SET-STRUC-INSERT GENL (STRUCTURE-INSERT)
WORTH (0)
ALGS (ANY1OF (TYPE NONRECURSIVE OPAQUE QUICK
(AND [OR BA2 [SETQ BA2 (LIST (CAAR (LAST (GETB (QUOTE SET-STRUC)
(QUOTE EXS]
(BOOST (LIST (QUOTE FILLIN)
(QUOTE SET-STRUC)
(QUOTE EXS]
(OR BA1 (NOT (FMEMB (SETQ BA1 (RAND-THING))
BA2))
(SETQ BA1 (COPY BA2)))
[OR (FMEMB BA1 (CDR BA2))
(FRPLACD BA2 (MERGE (LIST BA1)
(CDR BA2)
(QUOTE SORD]
BA2)))
UP (SET-STRUC-IN-DOM-OF)
D-R (OSET (ANYTHING SET-STRUC SET-STRUC))
SPEC NIL)
(PUTPROPS SET-STRUC-INTERSECT GENL (STRUCTURE-INTERSECT)
WORTH (0)
ALGS (ANY1OF (TYPE NONRECURSIVE QUICK OPAQUE (INTERSECTION BA1 BA2))
[TYPE NONRECURSIVE (ANY1OF [SUBSET BA1 (FUNCTION (LAMBDA
(Z)
(APPLYB (QUOTE
STRUCTURE-MEMB)
(QUOTE ALGS)
Z BA2]
(SUBSET BA2 (FUNCTION (LAMBDA
(Z)
(APPLYB (QUOTE
STRUCTURE-MEMB)
(QUOTE ALGS)
Z BA1]
(TYPE RECURSIVE (PROGN [COND ((SETQ BA4 (APPLYB (QUOTE STRUCTURE-MEMB)
(QUOTE ALGS)
NIL BA2))
(SETQ BA1 (APPLYB (QUOTE STRUCTURE-DELETE)
(QUOTE ALGS)
BA4 BA1))
(SETQ BA1 (APPLYB (QUOTE SET-STRUC-INTERSECT)
(QUOTE ALGS)
BA1 BA2))
(AND (APPLYB (QUOTE STRUCTURE-MEMB)
(QUOTE ALGS)
BA4 BA2)
(APPLYB (QUOTE SET-STRUC-INSERT)
BA4 BA1]
BA1)))
UP (SET-STRUC-IN-DOM-OF)
D-R (OSET (SET-STRUC SET-STRUC SET-STRUC))
SPEC NIL)
(PUTPROPS STRUCTURE GENL (OBJECT)
INT [IPLUS 0
(COND
(T 0 (MAX (CDR BA1)
(FUNCTION
(LAMBDA
(M1)
(DOTPROD (.9 .1)
(COND
((GETB M1 (QUOTE WORTH)))
((LIST (FAN [COND ((GETB M1 (QUOTE GENL)))
[(SUBSET CONCEPTS
(FUNCTION
(LAMBDA
(KC)
(MEMBER M1
(GETB KC
(QUOTE EXS]
((LIST (QUOTE ANYB]
(QUOTE INT)
M1]
SPEC NIL
IN-DOM-OF (STRUCTURE-INSERT STRUCTURE-MEMB STRUCTURE-DELETE STRUCTURE-EQUAL)
WORTH (0)
VIEW [ANY-OF
[PROG1 NIL (SETQ GTEMP5 (RIPPLE BA1 (QUOTE GENL]
(AND (FMEMB (QUOTE STRUCTURE)
GTEMP5)
(APPEND (PROGN [SETQ GTEMP3
(LIST (CAAR (LAST (OR (GETB (SETQ GTEMP4
(CAR (INTERSECTION
(SPEC STRUCTURE)
GTEMP5)))
(QUOTE EXS))
GEXISTING]
(OR GTEMP4 (SETQ GTEMP4 CS-B))
[SETQ GTEMP4 (PACK (LIST GTEMP4 (QUOTE -INSERT]
(OR (NOT (GETHASH GTEMP4 HCON))
[MAPC (REVERSE (CDR BA2))
(FUNCTION (LAMBDA (Z)
(SETQ GTEMP3 (APPLYB GTEMP4 (QUOTE ALGS)
Z GTEMP3]
(LIST GTEMP3]
DEFN (ANY-OF NIL)
DEFN-NOT (ANY-OF (NLISTP BA1)))
(PUTPROPS STRUCTURE-DELETE GENL (OPERATION)
WORTH (0)
ALGS [ANY1OF [TYPE NONRECURSIVE (AND (SETQ GTEMP7 (FMEMB BA1 (CDR BA2)))
(COND ((CDR GTEMP7)
(RPLACA GTEMP7 (APPEND (CADR GTEMP7)))
(RPLACD GTEMP7 (CDDR GTEMP7)))
((RPLACD BA2 (DREMOVE BA1 (CDR BA2]
(TYPE RECURSIVE (COND ((NULL (SETQ BA3 (APPLYB (QUOTE FIRST)
(QUOTE ALGS)
BA2)))
BA2)
(T (RPLACD BA2 (CDDR BA2))
(COND ((APPLYB (QUOTE OBJ-EQUAL)
(QUOTE ALGS)
BA1 BA3)
BA2)
(T (APPLYB (QUOTE BAG-STRUC-INSERT)
(QUOTE ALGS)
BA3
(APPLYB (QUOTE STRUCTURE-DELETE)
(QUOTE ALGS)
BA1 BA2]
UP (STRUCTURE-IN-DOM-OF OPERATION)
INV (TYPE NONRECURSIVE TRANSFORM (PROGN (ARG-SUBST (QUOTE BA1)
(RAND-MEMB (UNDO-INIT CS-P GEXISTING))
(QUOTE BA2)
(RAND-THING))
(APPLYB (QUOTE STRUCTURE-INSERT)
(QUOTE ALGS)
(OR (AND (LISTP BA1)
(EQ (CAR BA1)
(QUOTE APPLYB))
(EVAL (SUBST (QUOTE INV)
(QUOTE ALGS)
BA1)))
BA1)
(OR (AND (LISTP BA2)
(EQ (CAR BA2)
(QUOTE APPLYB))
(EVAL (SUBST (QUOTE INV)
(QUOTE ALGS)
BA2)))
BA2)
BA3)))
D-R (OSET (ANYTHING STRUCTURE STRUCTURE))
SPEC (BAG-STRUC-DELETE LIST-STRUC-DELETE OSET-STRUC-DELETE SET-STRUC-DELETE))
(PUTPROPS STRUCTURE-DIFF GENL (OPERATION)
WORTH (0)
ALGS [ANY1OF (TYPE NONRECURSIVE OPAQUE QUICK (AND (LISTP BA1)
(LISTP BA2)
(EQ (CAR BA1)
(CAR BA2))
(SUBSET BA1
(FUNCTION
(LAMBDA
(Z)
(PROG1 (EQUAL Z (CAR BA2))
(SETQ BA2 (CDR BA2]
UP (STRUCTURE-IN-DOM-OF OPERATION)
INV (TYPE NONRECURSIVE TRANSFORM (APPLYB (QUOTE STRUCTURE-DIFF)
(QUOTE ALGS)
BA2 BA1 BA3))
D-R (OSET (STRUCTURE STRUCTURE STRUCTURE))
SPEC (SET-STRUC-DIFF))
(PUTPROPS STRUCTURE-EQUAL GENL (OBJ-EQUAL)
WORTH (0)
UP (STRUCTURE-IN-DOM-OF OPERATION)
D-R (OSET (STRUCTURE STRUCTURE TRUTH-VAL))
SPEC NIL)
(PUTPROPS STRUCTURE-EXS GENL [ANYB-EXS (OR-RUN: (LIST (RIPPLE1 (QUOTE STRUCTURE)
(QUOTE EXS)
(QUOTE GENL]
FILLIN2 [APPEND (MAPCONC (REMOVE CS-B (KINDS-OF (QUOTE STRUCTURE)))
(FUNCTION (LAMBDA (S)
(MAPCONC (APPLY* (QUOTE EXS)
S)
(FUNCTION (LAMBDA (X1)
(APPLY* (QUOTE VIEW)
S CS-B X1]
WORTH (0)
SPEC NIL)
(PUTPROPS STRUCTURE-EXS-BDY GENL [ANYB-EXS-BDY (OR-RUN: (LIST (RIPPLE1 (QUOTE STRUCTURE)
(QUOTE EXS-BDY)
(QUOTE GENL]
FILLIN2 [APPEND [MAPCONC (REMOVE CS-B (KINDS-OF (QUOTE STRUCTURE)))
(FUNCTION (LAMBDA (S)
(MAPCONC (APPLY* (QUOTE EXS-BDY)
S)
(FUNCTION (LAMBDA
(X1)
(APPLY* (QUOTE VIEW)
S CS-B X1]
(PROG1 NIL [ADD-CANDS (LIST (CONS (AVG2 DO-THRESH CS-INT)
(SETQ GTEMP11 (LIST (QUOTE CHECK)
CS-B
(QUOTE EXS]
(MAPC PAST (FUNCTION (LAMBDA (Z)
(AND (EQUAL (CAR Z)
GTEMP11)
(ATTACH (QUOTE INCONCLUSIVELY)
(CAR Z]
WORTH (0)
SPEC NIL)
(PUTPROPS STRUCTURE-INSERT GENL (OPERATION)
WORTH (0)
ALGS [ANY1OF (TYPE NONRECURSIVE CASES BRANCH
(PROGN [SETQ GTEMP3
(CAR (SOME (PROGN (SETQ GTEMP2 (SPEC STRUCTURE))
(OR (AND BA3 (FMEMB BA3 GTEMP2)
(CONS BA3 (REMOVE BA3 GTEMP2)))
GTEMP2))
(FUNCTION (LAMBDA
(S)
(OR (FMEMB S (UP BA2))
(FMEMB BA2 (APPLY*
(QUOTE EXS)
S))
(APPLYB S (QUOTE DEFN)
BA2]
(OR (AND BA3 (NEQ BA3 GTEMP3)
BA2
(SETQ GTEMP1 (APPLY* (QUOTE VIEW)
GTEMP3 BA3 BA2))
(SETQ GTEMP3 BA3)
(SETQ BA2 GTEMP1))
(AND (NOT GTEMP3)
BA3
(SETQ GTEMP3 BA3)))
(AND (GETHASH [SETQ GTEMP3 (PACK (LIST GTEMP3 (QUOTE -INSERT]
HCON)
(APPLYB GTEMP3 (QUOTE ALGS)
BA1 BA2]
UP (STRUCTURE-IN-DOM-OF OPERATION)
D-R (OSET (ANYTHING STRUCTURE STRUCTURE))
SPEC (BAG-STRUC-INSERT LIST-STRUC-INSERT OSET-STRUC-INSERT SET-STRUC-INSERT))
(PUTPROPS STRUCTURE-INTERSECT GENL (OPERATION)
WORTH (0)
UP (STRUCTURE-IN-DOM-OF OPERATION)
ALGS [ANY1OF (TYPE NONRECURSIVE CASES BRANCH
(PROGN [SETQ GTEMP3
(CAR (SOME (PROGN (SETQ GTEMP2 (SPEC STRUCTURE))
(OR (AND BA3 (FMEMB BA3 GTEMP2)
(CONS BA3 (REMOVE BA3 GTEMP2)
))
GTEMP2))
(FUNCTION
(LAMBDA (S)
(OR (FMEMB S (UP BA2))
(FMEMB BA2
(APPLY* (QUOTE EXS)
S))
(APPLYB S (QUOTE DEFN)
BA2]
(OR (AND BA3 (NEQ BA3 GTEMP3)
BA2
(SETQ GTEMP1 (APPLY* (QUOTE VIEW)
GTEMP3 BA3 BA2))
(SETQ GTEMP3 BA3)
(SETQ BA2 GTEMP1))
(AND (NOT GTEMP3)
BA3
(SETQ GTEMP3 BA3)))
(APPLYB (PACK (LIST GTEMP3 (QUOTE INTERSECT)))
(QUOTE ALGS)
BA1 BA2]
D-R (OSET (STRUCTURE STRUCTURE STRUCTURE))
SPEC (SET-STRUC-INTERSECT))
(PUTPROPS STRUCTURE-MEMB GENL (OPERATION)
WORTH (0)
ALGS [ANY1OF (TYPE QUICK OPAQUE (MEMBER BA1 BA2))
[TYPE RECURSIVE (AND BA1 (SETQ BA3 (RAND-MEMB (CDR BA2)))
(OR (APPLYB (QUOTE OBJ-EQUAL)
(QUOTE ALGS)
BA1 BA3)
(APPLYB (QUOTE STRUCTURE-MEMB)
(QUOTE ALGS)
BA1
(APPLYB (QUOTE STRUCTURE-DELETE)
(QUOTE ALGS)
BA3 BA2]
[TYPE NONRECURSIVE CASES (COND ((AND BA1 (LISTP BA2))
(MEMBER BA1 (CDR BA2)))
((AND (NOT BA1)
(LISTP BA2))
(RAND-MEMB (CDR BA2)))
[(AND BA1 (ATOM BA2))
(APPLYB (QUOTE STRUCTURE-INSERT)
(QUOTE ALGS)
BA1
(RAND-MEMB (GETB BA2 (QUOTE EXS]
((AND BA1 (NOT BA2))
(APPLYB (QUOTE STRUCTURE-INSERT)
(QUOTE ALGS)
BA1
(RAND-MEMB (EXS STRUCTURE]
(TYPE ITERATIVE (AND BA1 (SOME (CDR BA2)
(FUNCTION (LAMBDA (Z)
(APPLYB (QUOTE OBJ-EQUAL)
(QUOTE ALGS)
BA1 Z]
UP (STRUCTURE-IN-DOM-OF OPERATION)
INV [TYPE NONRECURSIVE CASES (COND ((AND BA1 (LISTP BA2))
(NOT (APPLYB (QUOTE STRUCTURE-MEMB)
(QUOTE ALGS)
BA1 BA2)))
((AND (NOT BA1)
(LISTP BA2))
(PROG (Z)
L1
(SETQ Z (RAND-THING))
(COND ((FMEMB Z BA2)
(GO L1)))
(RETURN Z)))
((AND BA1 (ATOM BA2))
(APPLYB (QUOTE STRUCTURE-INSERT)
(QUOTE INV)
BA1
(RAND-MEMB (OR (GETB BA2 (QUOTE EXS))
(APPLY* (QUOTE EXS)
BA2)
(EXS STRUCTURE]
D-R (OSET (ANYTHING STRUCTURE TRUTH-VAL))
SPEC NIL)
(PUTPROPS TRUTH-VAL GENL (OBJECT)
IN-RAN-OF (PREDICATE)
WORTH (0)
DEFN [ANY-OF (TYPE NONRECURSIVE CASES (COND ((EQUAL BA1 T))
((EQUAL BA1 NIL))
(T NIL]
ALGS [ANY1OF (TYPE NONRECURSIVE CASES (COND (BA1 T)
(T NIL]
SPEC NIL)
(PUTPROPS UNORD-OBJ GENL (OBJECT)
SPEC NIL
WORTH (0))
(PUTPROPS UNORD-OBJ-EXS GENL (OBJECT-EXS)
WORTH (0)
CHECK1 [AND (GETHASH [SETQ GTEMP4 (PACK (LIST CS-B (QUOTE -INSERT]
HCON)
(SETQ GEXISTING (SETB CS-B (QUOTE EXS)
(APPEND (GETB (QUOTE ANYB-EXS)
(QUOTE INIT))
(ANY1OF [MAPCAR (GETB CS-B (QUOTE EXS))
(FUNCTION
(LAMBDA
(Z)
(CONS (CAR Z)
(SORT (CDR Z)
(QUOTE SORD]
(MAPCAR (GETB CS-B (QUOTE EXS))
(FUNCTION
(LAMBDA
(Z X)
(SETQ X (LIST (CAR Z)))
[MAPC (REVERSE (CDR Z))
(FUNCTION
(LAMBDA
(ZZ)
(APPLYB GTEMP4
(QUOTE ALGS)
ZZ X]
X]
SPEC NIL)
(PUTPROPS ALGS ARGS (BA1 BA2 BA3 BA4)
CENT (GENL)
UNDO-INIT ACCESS)
(PUTPROPS ANAS ARGS (BA1 BA2 BA3)
UNDO-INIT ACCESS)
(PUTPROPS CHECK ARGS (BA1 BA2 BA3)
CENT (GENL)
UNDO-INIT ACCESS)
(PUTPROPS CHECK1 ARGS (BA1 BA2 BA3 BA4)
UNDO-INIT ACCESS)
(PUTPROPS CHECK2 ARGS (BA1 BA2 BA3 BA4)
UNDO-INIT ACCESS)
(PUTPROPS D-R ARGS (BA1 BA2 BA3)
UNDO-INIT CDR)
(PUTPROPS DEFN ARGS (BA1 BA2 BA3)
CENT (SPEC)
UNDO-INIT ACCESS)
(PUTPROPS DEFN-NOT ARGS (BA1 BA2 BA3 BA4)
CENT (GENL)
UNDO-INIT ACCESS)
(PUTPROPS DOMAIN ARGS (BA1 BA2 BA3 BA4)
UNDO-INIT ACCESS)
(PUTPROPS EXS ARGS (BA1 BA2 BA3)
CENT (SPEC)
UNDO-INIT CDDR)
(PUTPROPS EXS-BDY ARGS (BA1 BA2 BA3)
UNDO-INIT CDDR)
(PUTPROPS EXS-NOT ARGS (BA1 BA2 BA3)
UNDO-INIT ACCESS)
(PUTPROPS EXS-NOT-BDY ARGS (BA1 BA2 BA3)
INIT NIL
UNDO-INIT CDDR)
(PUTPROPS FILLIN ARGS (BA1 BA2 BA3)
CENT (GENL)
UNDO-INIT ACCESS)
(PUTPROPS FILLIN1 ARGS (BA1 BA2 BA3 BA4)
UNDO-INIT ACCESS)
(PUTPROPS FILLIN2 ARGS (BA1 BA2 BA3 BA4)
UNDO-INIT ACCESS)
(PUTPROPS GENL ARGS (BA1 BA2 BA3)
CENT (GENL)
UNDO-INIT ACCESS)
(PUTPROPS IN-DOM-OF ARGS (BA1 BA2 BA3 BA4)
CENT (GENL)
UNDO-INIT ACCESS)
(PUTPROPS IN-RAN-OF ARGS (BA1 BA2 BA3 BA4)
CENT (GENL)
UNDO-INIT ACCESS)
(PUTPROPS INIT ARGS (BA1 BA2 BA3 BA4)
UNDO-INIT ACCESS)
(PUTPROPS INST ARGS (BA1 BA2)
UNDO-INIT CDDR
CENT (SPEC))
(PUTPROPS INT ARGS (BA1 BA2 BA3)
UNDO-INIT ACCESS)
(PUTPROPS INT-NOT ARGS (BA1 BA2 BA3)
UNDO-INIT ACCESS)
(PUTPROPS INTU ARGS (BA1 BA2 BA3)
UNDO-INIT ACCESS)
(PUTPROPS INV ARGS (BA1 BA2 BA3 BA4)
CENT (GENL)
UNDO-INIT ACCESS)
(PUTPROPS RANGE ARGS (BA1 BA2 BA3 BA4)
UNDO-INIT ACCESS)
(PUTPROPS RESTRUC ARGS (BA1 BA2 BA3)
UNDO-INIT ACCESS)
(PUTPROPS SPEC ARGS (BA1 BA2 BA3)
CENT (SPEC)
UNDO-INIT ACCESS)
(PUTPROPS SUGG ARGS (BA1 BA2 BA3)
UNDO-INIT ACCESS)
(PUTPROPS UP ARGS (BA1 BA2 BA3)
UNDO-INIT ACCESS)
(PUTPROPS VIEW ARGS (BA1 BA2 BA3 BA4)
CENT (GENL)
UNDO-INIT ACCESS)
(PUTPROPS WORTH ARGS (BA1 BA2 BA3)
UNDO-INIT ACCESS)
(PUTPROPS FILLIN1 ARGS (BA1 BA2 BA3 BA4)
UNDO-INIT ACCESS)
(PUTPROPS FILLIN2 ARGS (BA1 BA2 BA3 BA4)
UNDO-INIT ACCESS)
(PUTPROPS CHECK1 ARGS (BA1 BA2 BA3 BA4)
UNDO-INIT ACCESS)
(PUTPROPS CHECK2 ARGS (BA1 BA2 BA3 BA4)
UNDO-INIT ACCESS)
(INIT-C)
[DECLARE: DONTEVAL@LOAD DOEVAL@COMPILE DONTCOPY COMPILERVARS
(ADDTOVAR NLAMA VECTOR STRUC PAIR OSET FORMAT CLASS BAG)
(ADDTOVAR NLAML WORTH VIEW UP SUGG SPEC RESTRUC RANGE INV INTU INT-NOT INT INIT IN-RAN-OF IN-DOM-OF GENL FILLIN2
FILLIN1 FILLIN EXS-NOT-BDY EXS-NOT EXS-BDY EXS DOMAIN DEFN-NOT DEFN D-R CHECK2 CHECK1 CHECK ANAS ALGS)
]
(LISPXPRINT (QUOTE CON4COMS)
T T)
[RPAQQ CON4COMS
((FNS BAG CLASS FORMAT INIT-C OSET PAIR STRUC VECTOR)
CONCEPTS
(VARS * CONCEPTS)
FACETS
(VARS * FACETS)
(FNS * FACETS)
AUX-FACETS
(VARS * AUX-FACETS)
SUF-PARTS STRATEGY-PARTS XEQ-PARTS XS-PARTS OR-PARTS [COMS * (LIST (CONS (QUOTE IFPROP)
(CONS (QUOTE ALL)
CONCEPTS]
[COMS * (LIST (CONS (QUOTE IFPROP)
(CONS (QUOTE ALL)
FACETS]
[COMS * (LIST (CONS (QUOTE IFPROP)
(CONS (QUOTE ALL)
AUX-FACETS]
(P (INIT-C))
(DECLARE: DONTEVAL@LOAD DOEVAL@COMPILE DONTCOPY COMPILERVARS
(ADDVARS (NLAMA VECTOR STRUC PAIR OSET FORMAT CLASS BAG)
(NLAML WORTH VIEW UP SUGG SPEC RESTRUC RANGE INV INTU INT-NOT INT INST INIT IN-RAN-OF
IN-DOM-OF GENL FILLIN2 FILLIN1 FILLIN EXS-NOT-BDY EXS-NOT EXS-BDY EXS DOMAIN
DEFN-NOT DEFN D-R CHECK2 CHECK1 CHECK ANAS ALGS]
[DECLARE: DONTEVAL@LOAD DOEVAL@COMPILE DONTCOPY COMPILERVARS
(ADDTOVAR NLAMA VECTOR STRUC PAIR OSET FORMAT CLASS BAG)
(ADDTOVAR NLAML WORTH VIEW UP SUGG SPEC RESTRUC RANGE INV INTU INT-NOT INT INST INIT IN-RAN-OF IN-DOM-OF GENL FILLIN2
FILLIN1 FILLIN EXS-NOT-BDY EXS-NOT EXS-BDY EXS DOMAIN DEFN-NOT DEFN D-R CHECK2 CHECK1 CHECK ANAS ALGS)
]
(DECLARE: DONTCOPY
(FILEMAP (NIL (1142 3975 (BAG 1154 . 1203) (CLASS 1207 . 1260) (FORMAT 1264 . 1319) (INIT-C 1323 . 3746) (OSET 3750
. 3801) (PAIR 3805 . 3856) (STRUC 3860 . 3913) (VECTOR 3917 . 3972)) (9310 14019 (ALGS 9322 . 9405) (ANAS 9409 . 9486)
(CHECK 9490 . 10142) (CHECK1 10146 . 10203) (CHECK2 10207 . 10264) (D-R 10268 . 10319) (DEFN 10323 . 10769) (DEFN-NOT
10773 . 11002) (DOMAIN 11006 . 11383) (EXS 11387 . 11438) (EXS-BDY 11442 . 11501) (EXS-NOT 11505 . 11564) (EXS-NOT-BDY
11568 . 11635) (FILLIN 11639 . 12335) (FILLIN1 12339 . 12398) (FILLIN2 12402 . 12461) (GENL 12465 . 12515) (IN-DOM-OF
12519 . 12582) (IN-RAN-OF 12586 . 12649) (INIT 12653 . 12706) (INST 12710 . 12763) (INT 12767 . 12842) (INT-NOT 12846
. 12929) (INTU 12933 . 13010) (INV 13014 . 13097) (RANGE 13101 . 13476) (RESTRUC 13480 . 13539) (SPEC 13543 . 13593)
(SUGG 13597 . 13674) (UP 13678 . 13727) (VIEW 13731 . 13957) (WORTH 13961 . 14016)))))
STOP